Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PASCALL/SHAPES/BLEEP.PAS

Pascal/Delphi Source File | 1993-08-30 | 6KB | 231 lines

program Bleep;
uses
   Crt,Graph,Objects,Polygony;

procedure GetNum(a:integer; var n:integer);
var
   bin:integer;
begin
   n:=0;
   if paramcount>=a then
   begin
      val(paramstr(a),n,bin);
   end
end;

const
   acVacnt=    0;
   acReNew=    10;
   acCycle=    20;
type
   PBalls=^TBalls;
   TBalls=object(TObject)
      Collection                                   :     PCollection;
      Count                                        ,
      Number                                       ,
      shp                                          ,
      At                                           ,
      Cnt                                          ,
      Change                                       :     Integer;
      Action                                       :     Byte;
    constructor Init(N:Integer;shpe:integer);
      procedure Initballs(var N:Integer);
      procedure Cycle;
      procedure Run;
      procedure ReNew;
      procedure Doer;
     destructor Done;                                    virtual;
   end;
constructor TBalls.Init(N:Integer; shpe:integer);
begin
   inherited Init;
   New(Collection,Init(N,0));
   shp:=shpe;
   Number:=N;
   Initballs(Number);
   change:=100;
end;
procedure   TBalls.InitBalls(var N:Integer);
var
   a: integer;
   procedure NewDot;
   begin
      if maxavail>176 then
      Collection^.Insert(New(PDot ,Init(((Random(GetMaxy)+1) div 8),random(getmaxcolor)+1,random(4),random(2))));
   end;
   procedure NewBall;
   begin
      if maxavail>176 then
      Collection^.Insert(New(PBall,Init(((Random(GetMaxy)+1) div 8),random(getmaxcolor)+1,random(4),random(2))));
   end;
   procedure NewBox;
   begin
      if maxavail>176 then
      Collection^.Insert(New(PBox ,Init(((Random(GetMaxy)+1) div 8),random(getmaxcolor)+1,random(4),random(2))));
   end;
begin
   for a:=1 to N do
   begin
      if maxavail<=176 then
      begin
         N:=a-1;
         Exit;
      end;
      case shp of
         0: NewDot;
         1: NewBall;
         2: NewBox;
         3: case random(3) of
               0: NewDot;
               1: NewBall;
               2: NewBox;
            end;
      end
   end;
end;
procedure   TBalls.ReNew;
begin
   count:=0;
   change:=random(1000)+1;
   if Action<>AcReNew then At:=0;
   Action:=acReNew;
   if (At>-1) and (At<Number) then
      With PDot(Collection^.At(At))^ do
      begin
         ReNew;
         Doer;
      end;
   Inc(At);
   if At=Number then Action:=acVacnt;
end;
procedure   TBalls.Doer;
begin
   case Action of
      acVacnt: begin
                  if count>=change then ReNew;
                  Cycle;
                  Inc(Count);
               end;
      acCycle: Cycle;
      acReNew: ReNew;
   end;
end;
procedure   TBalls.Cycle;
begin
   if Action<>acCycle then At:=0;
   Action:=acCycle;
   if (At>-1) and (At<Number) then PDot(Collection^.At(At))^.Doer;
   Inc(At);
   if At=Number then Action:=acVacnt;
end;
procedure   TBalls.Run;
begin
   repeat
      Doer;
   until keypressed;
end;
destructor  TBalls.Done;
begin
   if Collection<>nil then Dispose(Collection,Done);
   inherited Done;
end;

type
   TProg=object(TObject)
      Using                                        :     PBalls;
      shp                                          ,
      Greater                                      :     Integer;
    constructor Init(shpe:integer);
      procedure Run;                                     virtual;
     destructor Done;                                    virtual;
   end;
constructor TProg.Init(shpe:integer);
var
   gd,gm:integer;
begin
   gd:=vga;  gm:=vgahi;
   InitGraph(gd,gm,'c:\tp\bgi');

   inherited Init;
   GetNum(2,Greater);
   if Greater<=0 then Greater:=5;
   shp:=shpe;
   randomize;
   New(Using,Init(Greater,shp));
end;
procedure   TProg.Run;
var
   s:boolean;
begin
   s:=false;
   repeat
      Using^.Run;
      case readkey of
         #32: begin
                 Dispose(Using,Done);
                 New(Using,Init(Greater,shp));
              end;
         #13: Using^.ReNew;
         #27: s:=True;
      end;
   until s;
end;
destructor  TProg.Done;
begin
   if Using<>nil then Dispose(Using,Done);
   inherited Done;
   RestoreCrtMode;
end;

var
   A:TProg;
   t:integer;
begin
   if pos('?',paramstr(1)+paramstr(2))=0 then
   begin
      GetNum(1,t);
      Write('Bleep v1.5 using ');
      case t of
         0: Write('pixel dots');
         1: Write('circles');
         2: Write('boxes');
         3: Write('random polygons');
      end;
      GetNum(2,t);
      if t<=0 then t:=5;
      Writeln(', at ',t,' max counts.');
      Writeln;
      Writeln('Press Any Key to Continue');
      readln;
      GetNum(1,t);
      A.Init(t);
      A.Run;
      A.Done;
      Writeln('Thanks for using Bleep v1.5');
   end
   else begin
      Writeln;
      Writeln('Bleep v1.5');
      Writeln('COPRIGHT 1993 Fernando Padilla.  ALL RIGHTS RESERVED.');
      Writeln('Will grant Public Domain use on program, but not on code.');
      Writeln;
      Writeln('Syntax: BLEEP # #######');
      Writeln('              ^    ^');
      Writeln(' Polygon Code-/    |');
      Writeln(' Polygon Count-----/');
      Writeln;
      Writeln;
      Writeln(' Polygon Code:');
      Writeln('        0 - pixel dots');
      Writeln('        1 - circles-------- sizes change during run time');
      Writeln('        2 - boxes-------/');
      Writeln('        3 - random polygons (from above)');
      Writeln;
      Writeln(' Polygon Count:');
      Writeln('        Can be ANY number between 1 to 32767, but the high limit of polygons');
      Writeln('  depends of memory available.  So, if 32767 (or any number), Bleep will use');
      Writeln('  as many polygons as possible, with the memory available.  Also, if a value');
      Writeln('  of less than of equal to 0, the value of 5 will be used.');
      Writeln;
   end;
end.